perm filename CLEFXG.F4[RST,LCS] blob sn#231805 filedate 1976-08-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE CLEFS
C00010 ENDMK
C⊗;
	SUBROUTINE CLEFS
	DIMENSION KPNT1(11),JCLEF(2100),RCMIN(4),KPNT2(11),KCLEF(350)
	1,CM(4),LCLEF(350),KPNT3(11),MCLEF(350),NCLEF(350),ICLEF(350)
	1,KPNT4(11),KPNT5(11),KPNT6(11),KPNT7(11),JJCLEF(350)
	COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS /BM/F,G,H
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
	EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
	1 KPNT2(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
	1,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(KJ,KPNT1(11)),(KCLEF,JCLEF(351))
	1,(R3,RJQ(1)),(LCLEF,JCLEF(701)),(KL,KPNT3(11)),(KM,KPNT4(11))
	1,(MCLEF,JCLEF(1051)),(NCLEF,JCLEF(1401)),(KN,KPNT5(11))
	1,(KI,KPNT6(11)),(ICLEF,JCLEF(1751)),(KJJ,KPNT7(11))
	1,(JJCLEF,JCLEF(2101))
	J5=MOD(J5,100)
	IF(J5)J5=-J5
	CALL NOZERO(R6)
	IF(R7.EQ.0)R7=R6
C  IF P7 = 0, IT WILL EQUAL P6.
	IF(JA.GT.10)GO TO 9
	NAME='CLEF0'
	IF(J5.LT.20)GO TO 4
	R6=R6*.3
C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
	R7=R7*.3
	GO TO 4
9	IF(NAME.EQ.NJR)GO TO 4
	IF(NAME.EQ.0)GO TO 177
	IF(NJR.EQ.0)GO TO 4
177	IF(NJR.EQ.0)GO TO 8	
C  TO PICK UP BASIC DRAW NAME FROM P10 
	NAME=NJR
	GO TO 4
8	TYPE 5
5	FORMAT(' SET P10=1'/)
C  LEADS TO PROPER FILE CALL
4	NM=NAME+2*(J5/10)
C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
	JEZ=MOD(J5,10)+1
2	IF(NM.EQ.NM1)GO TO 30
	IF(NM.EQ.NM2)GO TO 30
	IF(NM.EQ.NM3)GO TO 30
	IF(NM.EQ.NM4)GO TO 30
	IF(NM.EQ.NM5)GO TO 30
	IF(NM.EQ.NM6)GO TO 30
	IF(NM.EQ.NM7)GO TO 30
C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	NPP=0
	IF(JA.NE.11)GO TO 1111
C  DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
	NPP=-1
	IF(LOOKF(NM))GO TO 1111
	TYPE 1112,NM
	RETURN
1112	FORMAT(1XA5,' -- NOT FOUND')
	KX=0
1111	CALL GETFI2(NM,NPP)
	GO TO(33,233,333,433,533,633),KX
C  GOES TO 133 WHEN KX IS 0
133	KX=1
	NM1=NM
	CALL FASTI2(KPNT1,11)
	CALL FASTI2(JCLEF,KJ)
C  NEW DATA READER  6/74 -- 5/75  HOLDS 3 .DMD FILES IF THEY FIT.
	IF(KJ.LE.350)GO TO 30
	KX=0
	NM2=0
	GO TO 30
33	CALL FASTI2(KPNT2,11)
	IF(KK.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(KCLEF,KK)
	NM2=NM
	KX=2
	GO TO 30
233	CALL FASTI2(KPNT3,11)
	IF(KL.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(LCLEF,KL)
	KX=3
	NM3=NM
C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
C  R6 IS SIZE FACTOR
	GO TO 30
333	CALL FASTI2(KPNT4,11)
	IF(KM.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(MCLEF,KM)
	KX=4
	NM4=NM
	GO TO 30
433	CALL FASTI2(KPNT5,11)
	IF(KN.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(NCLEF,KN)
	KX=5
	NM5=NM
	GO TO 30
533	CALL FASTI2(KPNT6,11)
	IF(KN.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(ICLEF,KI)
	KX=6
	NM6=NM
	GO TO 30
633	CALL FASTI2(KPNT7,11)
	IF(KN.GT.350)GO TO 1112
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(JJCLEF,KJJ)
	KX=0
	NM7=NM
30	IF(J5.GT.3)GO TO 811
	IF(JA.NE.3)GO TO 811
C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
	IF(R5.LT.100)GO TO 812
	RSTJ2=.8*RSTJ2
C  TO SET HGT. OF MINI CLEFS
	R4=R4+CM(JEZ)
C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
812	IF(JEZ.NE.4)GO TO 811
	R4=R4+2
	JEZ=3
C   ABOVE IS NOW AT TOP

811	A=R4
	R4=A+2.9
C  ADJUSTS HEIGHT(??)
	CALL CENTX
	R4=A

	L=KPNT1(JEZ)
	IF(NM.EQ.NM2)L=KPNT2(JEZ)+350
	IF(NM.EQ.NM3)L=KPNT3(JEZ)+700
	IF(NM.EQ.NM4)L=KPNT4(JEZ)+1050
	IF(NM.EQ.NM5)L=KPNT5(JEZ)+1400
	IF(NM.EQ.NM6)L=KPNT6(JEZ)+1750
	IF(NM.EQ.NM7)L=KPNT7(JEZ)+2100
	IF(L.LE.0)RETURN
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
	IF(J9.EQ.0)GO TO 31
C***** ROTATE *******
	R7=R7*RSTJ2
	R6=R6*RSTJ2
	N=JCLEF(L)
	KNT=701
C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
	JCLEF(KNT)=N
	DO 1 K=L+1,N+L-1
	CALL UNPACK(J,M,JCLEF(K))
	X=J*R6
	Y=M*R7
	JJ=JCLEF(K)/100000000
	AX=ATAN2(X,Y)*57.29578
	HYP=SQRT(X**2+Y**2)
	ROT=DEG+AX
	J=ROFF(HYP*COSD(ROT))
	M=ROFF(HYP*SIND(ROT))
	KNT=KNT+1
	IF(J)J=1000-J
	IF(M)M=1000-M
1	JCLEF(KNT)=M*10000+J+JJ*100000000
	L=701
C  ***********  SEE AT TOP **********
	R6=1.
	R7=1.
	RSTJ2=1.
C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
CC	CALL ROTATE(JCLEF,L)
	NM3=0
C  WIPES OUT DATA AREA FOR NM3
C  R9=P9=DEGREES OF ROTATION (0-360)
	IF(KK.GT.350)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
31	IF(R8.EQ.-2)GO TO 32
C			R8=-2 OMITS FILLER DURING PLOT
CCC	IF(IPLT)GO TO 77
	IF(IPLT)77,77,32
CCCC	IF(R8.NE.-1)GO TO 32
77	DO 3 K=L+1,JCLEF(L)+L
	IF(JCLEF(K).LT.200000000)GO TO 3
	JEZ=JCLEF(L)-1
	IF(K.GT.L+1)JEZ=JEZ-K+L+1
	CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
	GO TO 32
3	CONTINUE
C  FILLS ONLY WHEN PLOTING OR R8=-1
32	CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT

	END